home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
PGM_TOOL
/
TPRCDR10
/
FD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-26
|
7KB
|
222 lines
{ **************************************************************
* Programmer: Tony Papadimitriou *
* Program : FD (FileDate) *
* Uses : Dos,TPRecDir,TPUtils *
* Includes : Nothing *
* Links : Nothing *
* Created : Monday, August 3, 1992 6:26 pm *
* Updated : Saturday, December 25, 1993 12:39 pm *
* Language : (MSDOS) Turbo Pascal 6.0 *
* Purpose : Display the path of all files with the given *
* : date range (or today's date if none given) *
* -------------------- Version History --------------------- *
* 1.00 920803: Original *
* 1.10 930624: Added commands for >= and <= date searches *
* 1.20 931204: Allowed forward slashes in path specification *
* 1.30 931225: Replaced core routine with TPRecDir module *
* : Added date display and changed output a bit *
************************************************************** }
program FD;
uses
{$ifdef VER60} {$ifopt G+} CPU286, {$endif} {$endif}
Dos,
TPRecDir,
TPUtils;
const
progName = 'FD';
version = '1.30';
{ **************************************************************
* Routine : DisplayCopyright *
* Purpose : Display the program's copyright message *
************************************************************** }
procedure DisplayCopyright;
begin
Writeln(stderr);
Writeln(stderr,progName+' ver. '+version+' ■ Copyright (c) 1992-1994 by Tony G. Papadimitriou');
Writeln(stderr);
end; { DisplayCopyright }
function GetDrive(s:string): Integer;
var
drive: Integer;
begin
if (Length(s) >= 2) and (s[2] = ':') then
case s[1] of
'A'..'Z': drive := Ord(s[1]) - Ord('A') + 1;
'a'..'z': drive := Ord(s[1]) - Ord('a') + 1;
end { case }
else
drive := 0; { none found, use default }
GetDrive := drive;
end; { GetDrive }
procedure CheckArgs;
begin
if ParamCount = 0 then
begin
Writeln(stderr,'Usage: '+progName+' [<path>\]<mask>[;<mask>] [mm/dd/yy] [+|-]');
Writeln(stderr,' Find files matching given mask and date in all dirs under one specified');
Writeln(stderr,' ■ if date is left blank, today''s system date is used');
Writeln(stderr,' ■ if date is followed by a + all files with a date >= the one given');
Writeln(stderr,' will be displayed. Similarly,');
Writeln(stderr,' ■ if date is followed by a - all files with a date <= the one given');
Writeln(stderr,' will be displayed.');
Writeln(stderr);
Writeln(stderr,' Press ESC during search to interrupt prematurely.');
Halt(1);
end; { if }
end; { CheckArgs }
function ShowDate(dt: Longint): String;
var
t: DateTime;
temp: String[10];
ans: String;
begin
if dt = 0 then
begin
{$ifdef GREEK}
ShowDate := 'âäî êæòôäê';
{$else}
ShowDate := 'NOT VALID!';
{$endif}
exit;
end; { if }
UnPackTime(dt,t);
{$ifdef GREEK}
Str(t.Day,temp);
{$else}
Str(t.Month,temp);
{$endif}
if Length(temp) = 1 then temp := '0' + temp;
ans := temp;
{$ifdef GREEK}
Str(t.Month,temp);
{$else}
Str(t.Day,temp);
{$endif}
if Length(temp) = 1 then temp := '0' + temp;
ans := ans + '/' + temp;
Str(t.Year,temp);
ans := ans + '/' + temp;
ShowDate := ans;
end; { ShowDate }
procedure KillTimeIn(var time:Longint);
var
temp: DateTime;
begin
UnpackTime(time,temp);
with temp do
begin
hour := 0;
min := 0;
sec := 0;
end; { with }
PackTime(temp,time);
end; { KillTimeIn }
procedure ConvertStrToDate(date:string;var dt:DateTime);
var
temp,temp2: Byte;
error: Integer;
procedure CheckError(value: Word;min,max: Integer);
begin
if error <> 0 then
begin
Writeln(stderr,'Date conversion error. Not a valid date.');
Halt(1);
end; { if }
if (value < min) or (value > max) then
begin
Writeln(stderr,'Not a valid numeric value for MM/DD/YY');
Halt(1);
end; { if }
end; { CheckError }
begin
ChangeChar(date,sizeof(date),'-','/');
temp := Index(date,'/',false,1);
Val(Copy(date,1,temp-1),dt.month,error); { get MM }
CheckError(dt.month,1,12);
temp2 := Index(date,'/',false,2);
Val(Copy(date,temp+1,temp2-temp-1),dt.day,error); { get DD }
CheckError(dt.day,1,31);
Val(Copy(date,temp2+1,Length(date)),dt.year,error); { get YY }
if (dt.year > 79) and (dt.year < 100) then dt.year := dt.year + 1900;
if (dt.year < 80) then dt.year := dt.year + 2000;
CheckError(dt.year,1980,2079);
end; { ConvertStrToDate }
var
path: String;
mask: String;
todaysDate: DateTime;
dayOfWeek: Word;
compareTime: Longint;
fileCount: Word;
tempChar: Char;
direction: Shortint; { 1 is NEWER, 0 is SAME, -1 is OLDER }
{ function that's called from TPRecDir }
function List(rec: SearchRec): Boolean; far;
var
temp: String;
begin
List := Yes;
KillTimeIn(rec.time);
if ((direction = 0) and (rec.time = compareTime)) or
((direction = 1) and (rec.time >= compareTime)) or
((direction = -1) and (rec.time <= compareTime)) then
begin
Inc(fileCount);
temp := FExpand(rec.name);
if AttributeMatches(rec.attr,Directory) then
temp := temp + ' [DIR]';
Writeln(Left(temp,60,'.'),' ',ShowDate(rec.time));
end; { if }
end; { List }
begin
DisplayCopyright;
CheckArgs;
fileCount := 0;
path := ParamStr(1); { get path to search }
mask := GetMask(path);
path := GetPath(path);
tempChar := ' ';
if ParamStr(2) = '+' then tempChar := '+';
if ParamStr(2) = '-' then tempChar := '-';
if (ParamCount < 2) or ((ParamCount = 2) and ((tempChar = '+') or (tempChar = '-'))) then
begin
GetDate(todaysDate.year,todaysDate.month,todaysDate.day,dayOfWeek); { get today's date }
case tempChar of
'+': direction := 1;
'-': direction := -1;
' ': direction := 0;
end; { case }
end { if }
else
begin
ConvertStrToDate(ParamStr(2),todaysDate);
tempChar := ' ';
if ParamStr(3) = '+' then tempChar := '+';
if ParamStr(3) = '-' then tempChar := '-';
case tempChar of
'+': direction := 1;
'-': direction := -1;
' ': direction := 0;
end; { case }
end; { else }
with todaysDate do
begin
hour := 0;
min := 0;
sec := 0;
end; { with }
PackTime(todaysDate,compareTime);
ForEachFileIn(path,mask,AnyFile,True,True,@List);
Writeln(stderr,fileCount:0,' '+OneManyStr(fileCount,'file/dir','files/dirs')+' found');
end.